home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / twview91.zip / MISC.INC < prev    next >
Text File  |  1992-03-11  |  7KB  |  293 lines

  1. function str( n : integer; width : integer ) : string;
  2. { convert integer to string }
  3. var
  4.   negative : boolean;
  5.   s : string;
  6. begin
  7.   if n = 0 then
  8.     s := '0'
  9.   else
  10.     begin
  11.       negative := false;
  12.       s := '';
  13.       if n < 0 then
  14.         begin
  15.           negative := true;
  16.           n := -n;
  17.         end;
  18.       while n > 0 do
  19.         begin
  20.           s := chr( n mod 10 + ord('0') ) + s;
  21.           n := n div 10;
  22.         end; {while}
  23.       if negative then
  24.         s := '-'+s;
  25.     end; {else}
  26.   while length(s) < width do
  27.     if odd( length(s) ) then
  28.       s := s + ' '
  29.     else
  30.       s := ' ' + s;
  31.   str := s;
  32. end; {str}
  33.  
  34. function die( size : integer ) : integer;
  35. begin
  36.   die := random( size )  + 1;
  37. end;
  38.  
  39. function prompt( p : string ) : boolean;
  40. { returns true if they say yes }
  41. var
  42.   ch : char;
  43. begin
  44.   write(p);
  45.   readln( ch );
  46.   prompt := ch in ['Y','y'];
  47. end; {again}
  48.  
  49. function GetNewFileName( promptstring : string; default : string ) : string;
  50. { Get a valid filename.  Warn if clobbering existing file. }
  51. var
  52.   filename : string;
  53.   g        : text;
  54.   errorcode: integer;
  55.  begin
  56.   repeat
  57.     write( promptstring, '[', default, ']  ' );
  58.     readln( filename );
  59.     if filename = '' then
  60.       if default = abort then
  61.         halt
  62.       else
  63.         filename := default;
  64.     if filename = abort then
  65.       halt;
  66.     assign( g, filename );
  67.     {$I-}
  68.     reset( g );
  69.     {$I+}
  70.     errorCode := ioResult;
  71.     if errorCode = 0 then 
  72.       begin
  73.         close( g );
  74.         write('File already exists! ');
  75.         if prompt('Overwrite? ') then
  76.           errorcode := FileNotFound;
  77.       end; {if}
  78.   until errorcode = FileNotFound;
  79.   GetNewFilename := filename;
  80. end; {GetNewFilename}
  81.  
  82. function GetOldFileName( promptstring : string; default : string ) : string;
  83. var
  84.   filename : string;
  85.   f        : text;
  86.   errorcode: integer;
  87. begin
  88.   repeat
  89.     write( promptstring, '[', default, ']  ' );
  90.     readln( filename );
  91.     if filename = '' then
  92.       if default = abort then
  93.         halt
  94.       else
  95.         filename := default;
  96.     if filename = abort then
  97.       halt;
  98.     assign( f, filename );
  99.     {$I-}
  100.     reset( f );
  101.     {$I+}
  102.     errorCode := ioResult;
  103.     if errorcode = 0 then
  104.       close( f )
  105.     else
  106.       writeln('Error ', errorCode, ' opening file!');
  107.   until errorCode = 0;
  108.   GetOldFileName := filename;
  109. end; {GetOldFileName}
  110.  
  111. function min( a, b : integer ) : integer;
  112. begin
  113.   if a > b then
  114.     min := b
  115.   else
  116.     min := a;
  117. end;
  118.  
  119. function minreal( a, b : real ) : real;
  120. begin
  121.   if a > b then
  122.     minreal := b
  123.   else
  124.     minreal := a;
  125. end; {minreal}
  126.  
  127. function IsWarp( from, OverTo : sector ) : boolean;
  128. { true if you can go from from to OverTo in one step }
  129. var
  130.   t : warpIndex;
  131. begin
  132.   IsWarp := false;
  133.   if space.sectors[ from ].number <> UnExplored then
  134.     for t := 1 to space.sectors[ from ].number do
  135.       if space.sectors[ from ].data[t] = OverTo then
  136.         IsWarp := true;
  137. end; {IsWarp}
  138.  
  139. function GetSector : SectorIndex;
  140. var
  141.   s : integer;
  142. begin
  143.   repeat
  144.     write('Sector? [0 to abort]  ');
  145.     readln( s );
  146.   until (s>=0) and (s<=MaxSector);
  147.   GetSector := s;
  148. end; {GetSector}
  149.  
  150. function LogToDisk( var f : text; message : string; default : string ) : boolean;
  151. var
  152.   filename : string;
  153.   ch       : char;
  154. begin
  155.   if not prompt( message ) then
  156.     LogToDisk := false
  157.   else
  158.     begin
  159.       LogToDisk := true;
  160.       assign( f, GetNewFilename( 'Log file? ', default) );
  161.       rewrite( f );
  162.     end; {else}
  163. end; {LogToDisk}
  164.  
  165. function upcase( ch : char ) : char;
  166. { if letter in 'a'..'z' give upper case equivalent }
  167. begin
  168.   if ch in ['a'..'z'] then
  169.     upcase := chr( ord( ch ) - ord('a') + ord('A') )
  170.   else
  171.     upcase := ch;
  172. end; {upcase}
  173.  
  174. function appearanceCount ( base : sector ) : integer;
  175. { returns number of sectors that warp into base sector }
  176. var
  177.   s : sector;
  178.   count : integer;
  179.   i : warpIndex;
  180. begin
  181.   count := 0;
  182.   for s := 1 to maxSector do
  183.     with space.sectors[s] do
  184.       for i := 1 to number do
  185.         if data[i] = base then
  186.           count := count + 1;
  187.   appearanceCount := count;
  188. end;
  189.  
  190. function HowFar( base : sector ) : integer;
  191. { return length of path leaving base sector }
  192. var
  193.   previous, current, NextUp : sector;
  194.   len : integer;
  195. begin
  196.   previous := base;
  197.   current := space.sectors[base].data[1];
  198.   len := 1;
  199.   while (space.sectors[current].number = 2) do
  200.     begin
  201.       NextUp := space.sectors[current].data[1];
  202.       if NextUp = previous then
  203.         NextUp := space.sectors[current].data[2];
  204.       previous := current;
  205.       current := nextUp;
  206.       len := len + 1;
  207.     end; {while}
  208.   HowFar := len;
  209. end;
  210.  
  211. procedure skip( var f : text; n : integer);
  212. var
  213.   ch : char;
  214. begin
  215.   for n := 1 to n do
  216.     read( f, ch );
  217. end; {skip}
  218.  
  219. function ReadNumber( var f : text) : integer;
  220. { Read the next number from text file f.  If there is no next number,
  221. return 0.}
  222. var
  223.   number : integer;
  224.   ch : char;
  225.   i  : integer;
  226. begin
  227.   number := 0;
  228.   if not eof( f ) then
  229.     begin
  230.       read( f, ch );
  231.       while (ch <= ' ') and (not eof(f)) do begin read( f, ch ); end;
  232.       repeat
  233.         if ch in ['0'..'9'] then
  234.           number := number * 10 + ord( ch ) - ord( '0' );
  235.         if not eof( f ) then
  236.           begin read( f, ch ); end
  237.         else
  238.           ch := #26;
  239.       until (not (ch in ['0'..'9']));
  240.       if ch = '[' then     {hit [PAUSE]^h^h^h^h^h^h^h}
  241.         skip( f, 32 );
  242.     end;
  243.   ReadNumber := number;
  244. end;
  245.  
  246. function PortNumber( s : sector ) : PortIndex;
  247. { return the entry into the list of ports corresponding to port s;
  248.   return 0 if port not found. }
  249. var
  250.   i : portptr;
  251. begin
  252.   PortNumber := 0;
  253.   if space.Ports.top > 0 then
  254.     for i := 1 to space.Ports.top do
  255.       if space.Ports.data[ i ].where = s then
  256.         PortNumber := i;
  257. end; {PortNumber}
  258.  
  259. function NoteNumber( s : sectorIndex ) : integer;
  260. { return the entry into the list of notes corresponding to sector s;
  261.   return 0 if note not found. }
  262. var
  263.   i : 0..MaxNote;
  264. begin
  265.   NoteNumber := 0;
  266.   if space.Ports.top > 0 then
  267.     for i := 1 to space.Notes.top do
  268.       if space.notes.data[ i ].reference = s then
  269.         NoteNumber := i;
  270. end; {PortNumber}
  271.  
  272. function GetPortType : stuff;
  273. var
  274.   pt : integer;
  275. begin
  276.   repeat
  277.     writeln('Describe this port:');
  278.     writeln(' 0 : BBB Buy all products');
  279.     writeln(' 1 : SBB Sell Fuel Ore; buy Organics and Equipment');
  280.     writeln(' 2 : BSB Sell Organics; buy Fuel Ore and Equipment');
  281.     writeln(' 3 : SSB Sell Fuel Ore and Organics; buy Equipment');
  282.     writeln(' 4 : BBS Sell Equipment; buy Fuel Ore and Organics');
  283.     writeln(' 5 : SBS Sell Equipment and Fuel Ore; buy Organics');
  284.     writeln(' 6 : BSS Sell Equipment and Organics; buy Fuel Ore');
  285.     writeln(' 7 : SSS Sell all products');
  286.     writeln(' 8 : Sell fighter, shields, holds (Class 0)');
  287.     writeln;
  288.     write('Port description? ');
  289.     readln( pt );
  290.   until (0<=pt) and (pt <= 8);
  291.   GetPortType := pt;
  292. end; {Get Port Type}
  293.